home *** CD-ROM | disk | FTP | other *** search
/ GameStar 2004 April / Gamestar_61_2004-04_dvdb.iso / DVDStar / Editace / hltp.exe / {app} / Source Code / Saidas LMP Edit / Unit1.pas < prev    next >
Pascal/Delphi Source File  |  2002-03-01  |  16KB  |  636 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, ComCtrls, ExtDlgs;
  8.  
  9.  
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     Image12: TImage;
  14.     MainMenu1: TMainMenu;
  15.     File1: TMenuItem;
  16.     Open1: TMenuItem;
  17.     Save1: TMenuItem;
  18.     N2: TMenuItem;
  19.     Exit1: TMenuItem;
  20.     Tools1: TMenuItem;
  21.     Import1: TMenuItem;
  22.     Export1: TMenuItem;
  23.     Help1: TMenuItem;
  24.     About1: TMenuItem;
  25.     LoadDialog: TOpenDialog;
  26.     StatusBar1: TStatusBar;
  27.     ImportDialog: TOpenPictureDialog;
  28.     ExportDialog: TSavePictureDialog;
  29.     SaveDialog: TSaveDialog;
  30.     N1: TMenuItem;
  31.     ExtractPalette1: TMenuItem;
  32.     bkimage: TImage;
  33.     N3: TMenuItem;
  34.     Backgroundcolor1: TMenuItem;
  35.     backgroundcolordialog: TColorDialog;
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure Open1Click(Sender: TObject);
  38.     procedure Exit1Click(Sender: TObject);
  39.     procedure Export1Click(Sender: TObject);
  40.     procedure FormPaint(Sender: TObject);
  41.     procedure Import1Click(Sender: TObject);
  42.     procedure Save1Click(Sender: TObject);
  43.     procedure ExtractPalette1Click(Sender: TObject);
  44.     procedure About1Click(Sender: TObject);
  45.     procedure Backgroundcolor1Click(Sender: TObject);
  46.   private
  47.   red, green, blue : integer;
  48.   PalColor: array[0..255] of TColor;
  49.   FileToLoad : String;
  50.   PaletteFound : Boolean;
  51.   procedure FixaRGB(palindex:integer);
  52.   procedure LoadPal;
  53.   procedure LoadLMP;
  54.   procedure ImportBitmap;
  55.   procedure SaveLmpImage;
  56.   Procedure LoadInternalPal;
  57.     { Private declarations }
  58.   public
  59.     { Public declarations }
  60.   end;
  61.  
  62. var
  63.   Form1: TForm1;
  64.  
  65. implementation
  66.  
  67. {$R *.DFM}
  68.  
  69. Procedure TForm1.LoadInternalPal;
  70. begin
  71. PalColor[0] := 0;
  72. PalColor[1] := 986895;
  73. PalColor[2] := 2039583;
  74. PalColor[3] := 3092271;
  75. PalColor[4] := 4144959;
  76. PalColor[5] := 4934475;
  77. PalColor[6] := 5987163;
  78. PalColor[7] := 7039851;
  79. PalColor[8] := 8092539;
  80. PalColor[9] := 9145227;
  81. PalColor[10] := 10197915;
  82. PalColor[11] := 11250603;
  83. PalColor[12] := 12303291;
  84. PalColor[13] := 13355979;
  85. PalColor[14] := 14408667;
  86. PalColor[15] := 15461355;
  87. PalColor[16] := 461583;
  88. PalColor[17] := 724759;
  89. PalColor[18] := 726815;
  90. PalColor[19] := 989991;
  91. PalColor[20] := 1254191;
  92. PalColor[21] := 1518391;
  93. PalColor[22] := 1519423;
  94. PalColor[23] := 1783627;
  95. PalColor[24] := 1784659;
  96. PalColor[25] := 2048859;
  97. PalColor[26] := 2050915;
  98. PalColor[27] := 2052971;
  99. PalColor[28] := 2054003;
  100. PalColor[29] := 2318203;
  101. PalColor[30] := 2320259;
  102. PalColor[31] := 2322319;
  103. PalColor[32] := 985867;
  104. PalColor[33] := 1774355;
  105. PalColor[34] := 2562843;
  106. PalColor[35] := 3352359;
  107. PalColor[36] := 4140847;
  108. PalColor[37] := 4929335;
  109. PalColor[38] := 5717823;
  110. PalColor[39] := 6768455;
  111. PalColor[40] := 7556943;
  112. PalColor[41] := 8346459;
  113. PalColor[42] := 9134947;
  114. PalColor[43] := 9923435;
  115. PalColor[44] := 10711923;
  116. PalColor[45] := 11500411;
  117. PalColor[46] := 12288899;
  118. PalColor[47] := 13339531;
  119. PalColor[48] := 0;
  120. PalColor[49] := 1799;
  121. PalColor[50] := 2827;
  122. PalColor[51] := 4883;
  123. PalColor[52] := 6939;
  124. PalColor[53] := 8995;
  125. PalColor[54] := 469803;
  126. PalColor[55] := 470831;
  127. PalColor[56] := 472887;
  128. PalColor[57] := 474943;
  129. PalColor[58] := 476999;
  130. PalColor[59] := 740171;
  131. PalColor[60] := 742227;
  132. PalColor[61] := 744283;
  133. PalColor[62] := 746339;
  134. PalColor[63] := 1010539;
  135. PalColor[64] := 7;
  136. PalColor[65] := 15;
  137. PalColor[66] := 23;
  138. PalColor[67] := 31;
  139. PalColor[68] := 39;
  140. PalColor[69] := 47;
  141. PalColor[70] := 55;
  142. PalColor[71] := 63;
  143. PalColor[72] := 71;
  144. PalColor[73] := 79;
  145. PalColor[74] := 87;
  146. PalColor[75] := 95;
  147. PalColor[76] := 103;
  148. PalColor[77] := 111;
  149. PalColor[78] := 119;
  150. PalColor[79] := 127;
  151. PalColor[80] := 4883;
  152. PalColor[81] := 6939;
  153. PalColor[82] := 8995;
  154. PalColor[83] := 11055;
  155. PalColor[84] := 12087;
  156. PalColor[85] := 14147;
  157. PalColor[86] := 473931;
  158. PalColor[87] := 475991;
  159. PalColor[88] := 477023;
  160. PalColor[89] := 740203;
  161. PalColor[90] := 1004407;
  162. PalColor[91] := 1267587;
  163. PalColor[92] := 1268619;
  164. PalColor[93] := 1793943;
  165. PalColor[94] := 2057123;
  166. PalColor[95] := 2320303;
  167. PalColor[96] := 463651;
  168. PalColor[97] := 726831;
  169. PalColor[98] := 991035;
  170. PalColor[99] := 1254219;
  171. PalColor[100] := 1518423;
  172. PalColor[101] := 2043747;
  173. PalColor[102] := 2307955;
  174. PalColor[103] := 2833279;
  175. PalColor[104] := 3359631;
  176. PalColor[105] := 3362719;
  177. PalColor[106] := 3105711;
  178. PalColor[107] := 3110847;
  179. PalColor[108] := 2854863;
  180. PalColor[109] := 2599903;
  181. PalColor[110] := 2083823;
  182. PalColor[111] := 1831935;
  183. PalColor[112] := 1803;
  184. PalColor[113] := 4891;
  185. PalColor[114] := 992043;
  186. PalColor[115] := 1256247;
  187. PalColor[116] := 1782599;
  188. PalColor[117] := 2307923;
  189. PalColor[118] := 2834275;
  190. PalColor[119] := 3360623;
  191. PalColor[120] := 4150143;
  192. PalColor[121] := 4677515;
  193. PalColor[122] := 5467035;
  194. PalColor[123] := 6257575;
  195. PalColor[124] := 7047095;
  196. PalColor[125] := 8098755;
  197. PalColor[126] := 9151443;
  198. PalColor[127] := 9941987;
  199. PalColor[128] := 10718123;
  200. PalColor[129] := 9928607;
  201. PalColor[130] := 8876947;
  202. PalColor[131] := 8087435;
  203. PalColor[132] := 7297919;
  204. PalColor[133] := 6509431;
  205. PalColor[134] := 5720939;
  206. PalColor[135] := 4931423;
  207. PalColor[136] := 4405079;
  208. PalColor[137] := 3616587;
  209. PalColor[138] := 3090243;
  210. PalColor[139] := 2301751;
  211. PalColor[140] := 1775403;
  212. PalColor[141] := 1250083;
  213. PalColor[142] := 723735;
  214. PalColor[143] := 460559;
  215. PalColor[144] := 10449851;
  216. PalColor[145] := 9399215;
  217. PalColor[146] := 8609699;
  218. PalColor[147] := 7821207;
  219. PalColor[148] := 7032715;
  220. PalColor[149] := 6245247;
  221. PalColor[150] := 5456755;
  222. PalColor[151] := 4930411;
  223. PalColor[152] := 4141919;
  224. PalColor[153] := 3615571;
  225. PalColor[154] := 2827079;
  226. PalColor[155] := 2301755;
  227. PalColor[156] := 1775407;
  228. PalColor[157] := 1250083;
  229. PalColor[158] := 723735;
  230. PalColor[159] := 460559;
  231. PalColor[160] := 12305371;
  232. PalColor[161] := 10990539;
  233. PalColor[162] := 10199999;
  234. PalColor[163] := 9148335;
  235. PalColor[164] := 8095651;
  236. PalColor[165] := 7306135;
  237. PalColor[166] := 6254471;
  238. PalColor[167] := 5464955;
  239. PalColor[168] := 4675435;
  240. PalColor[169] := 3885919;
  241. PalColor[170] := 3358547;
  242. PalColor[171] := 2569027;
  243. PalColor[172] := 2042679;
  244. PalColor[173] := 1515303;
  245. PalColor[174] := 987931;
  246. PalColor[175] := 461583;
  247. PalColor[176] := 8094575;
  248. PalColor[177] := 7306087;
  249. PalColor[178] := 6779743;
  250. PalColor[179] := 6253399;
  251. PalColor[180] := 5727055;
  252. PalColor[181] := 5200711;
  253. PalColor[182] := 4674367;
  254. PalColor[183] := 4148023;
  255. PalColor[184] := 3621679;
  256. PalColor[185] := 3095339;
  257. PalColor[186] := 2568995;
  258. PalColor[187] := 2042655;
  259. PalColor[188] := 1516311;
  260. PalColor[189] := 1252111;
  261. PalColor[190] := 725771;
  262. PalColor[191] := 461575;
  263. PalColor[192] := 1831935;
  264. PalColor[193] := 1564655;
  265. PalColor[194] := 1297371;
  266. PalColor[195] := 1030091;
  267. PalColor[196] := 1025979;
  268. PalColor[197] := 759723;
  269. PalColor[198] := 492443;
  270. PalColor[199] := 488331;
  271. PalColor[200] := 484219;
  272. PalColor[201] := 21355;
  273. PalColor[202] := 18267;
  274. PalColor[203] := 14155;
  275. PalColor[204] := 11067;
  276. PalColor[205] := 7979;
  277. PalColor[206] := 3867;
  278. PalColor[207] := 1803;
  279. PalColor[208] := 16711680;
  280. PalColor[209] := 15665931;
  281. PalColor[210] := 14619411;
  282. PalColor[211] := 13572891;
  283. PalColor[212] := 12526371;
  284. PalColor[213] := 11479851;
  285. PalColor[214] := 10432303;
  286. PalColor[215] := 9383727;
  287. PalColor[216] := 8335151;
  288. PalColor[217] := 7286575;
  289. PalColor[218] := 6237999;
  290. PalColor[219] := 5188395;
  291. PalColor[220] := 4137763;
  292. PalColor[221] := 3087131;
  293. PalColor[222] := 2036499;
  294. PalColor[223] := 985867;
  295. PalColor[224] := 43;
  296. PalColor[225] := 59;
  297. PalColor[226] := 1867;
  298. PalColor[227] := 1887;
  299. PalColor[228] := 3951;
  300. PalColor[229] := 464767;
  301. PalColor[230] := 466835;
  302. PalColor[231] := 731043;
  303. PalColor[232] := 996279;
  304. PalColor[233] := 1788867;
  305. PalColor[234] := 2843599;
  306. PalColor[235] := 3899355;
  307. PalColor[236] := 5216227;
  308. PalColor[237] := 6269927;
  309. PalColor[238] := 7847919;
  310. PalColor[239] := 9163767;
  311. PalColor[240] := 3898279;
  312. PalColor[241] := 3644343;
  313. PalColor[242] := 3654599;
  314. PalColor[243] := 5759975;
  315. PalColor[244] := 16760703;
  316. PalColor[245] := 16770987;
  317. PalColor[246] := 16777175;
  318. PalColor[247] := 103;
  319. PalColor[248] := 139;
  320. PalColor[249] := 179;
  321. PalColor[250] := 215;
  322. PalColor[251] := 255;
  323. PalColor[252] := 9696255;
  324. PalColor[253] := 13105151;
  325. PalColor[254] := 16777215;
  326. PalColor[255] := 5462943;
  327. end;
  328.  
  329. Procedure TForm1.SaveLmpImage;
  330. type
  331. TLMPRecord = packed record
  332.  Width : longint;
  333.  Height: longint;
  334. end;
  335. var
  336.  ThePixel : array [0..100000] of TColor;
  337.  TmpInt,TmpIntY, TmpIntX,storlek : Integer;
  338.  Filen:TFileStream;
  339.  Crapen:Byte;
  340.  LMPRec: TLMPRecord;
  341.  TmpByte: array [0..100000] of byte;
  342. begin
  343.  
  344.      TmpInt := 0;
  345.      storlek := Image12.Picture.Graphic.Height*Image12.Picture.Graphic.Width;
  346.      LMPRec.Width := Image12.Picture.Graphic.Width;
  347.      LMPRec.Height := Image12.Picture.Graphic.Height;
  348.       showmessage(inttostr(storlek));
  349.   if SaveDialog.Execute = True then
  350.   begin
  351.    try
  352.        Filen := TFileStream.Create(SaveDialog.Filename,fmCreate);
  353.        Filen.Position := 0;
  354.        Filen.Write(LMPRec,SizeOf(LMPRec));  //Write Header
  355.  
  356.  
  357.        for TmpIntY := 0 to Image12.Picture.Graphic.Height -1 do
  358.         begin
  359.          for TmpIntX := 0 to Image12.Picture.Graphic.Width -1 do
  360.           begin
  361.             ThePixel[TmpInt] := Image12.Picture.Bitmap.Canvas.Pixels[TmpIntX,TmpIntY];
  362.             Inc(TmpInt);
  363.           end;
  364.         end;
  365.  
  366.         for TmpInt := 0 to storlek do
  367.          begin
  368.            for Crapen := 0 to 255 do
  369.             begin
  370.               if ThePixel[TmpInt] = PalColor[Crapen] then
  371.                begin
  372.                  TmpByte[TmpInt] := Crapen;
  373.                end;
  374.             end;
  375.          end;
  376.  
  377.          try
  378.           filen.Write(TmpByte,storlek);
  379.          except
  380.          end;
  381.  
  382.  
  383.    finally
  384.     filen.Free;
  385.    end;
  386.   end;
  387. end;
  388.  
  389.  
  390. procedure TForm1.ImportBitmap;
  391. var
  392.  tmpBitmap:TBitmap;
  393. begin
  394.  if ImportDialog.Execute = True then
  395.   begin
  396.    try
  397.     tmpBitmap := TBitmap.Create;
  398.     tmpBitmap.PixelFormat := pf32bit;
  399.     tmpBitmap.LoadFromFile(ImportDialog.Filename);
  400.     Image12.Picture.Bitmap.Canvas.Draw(0,0,tmpBitmap);
  401.    finally
  402.     tmpBitmap.Free;
  403.    end;
  404.   end;
  405. end;
  406.  
  407. procedure TForm1.LoadLMP;
  408. type
  409. TLMPRecord = packed record
  410.  Width : longint;
  411.  Height: longint;
  412. end;
  413.  
  414. type TBildDel = packed record
  415.  bite : byte;
  416. end;
  417.  
  418. var
  419.  ms: TMemoryStream;
  420.  LMPRec: TLMPRecord;
  421.  BildRec : TBildDel;
  422.  tmpint,p,x,y:integer;
  423.  BildFil: array[0..1000000] of byte;
  424.  bitmap: TBitmap;
  425. begin
  426.  
  427. bitmap := TBitmap.Create;
  428. Bitmap.PixelFormat := pf32bit;
  429.  
  430.     tmpint := 0; x := 0; y := 0;  //Program will not work without it.
  431.     StatusBar1.SimpleText := 'Loading: ' + FileToLoad;
  432.  
  433.   //read height & width of LMP-File
  434.    ms:= TMemoryStream.Create;
  435.    ms.LoadFromFile(FileToLoad);
  436.    ms.Position:= 0;
  437.    ms.Read(LMPRec, Sizeof(LMPRec));
  438.    ms.Free;
  439.  
  440.    Bitmap.Width := LMPRec.Width;
  441.    Bitmap.Height := LMPRec.Height;
  442.    Bitmap.PixelFormat := pf32bit;
  443.  
  444.  
  445.    //Read the picture-part of the file
  446.    ms:= TMemoryStream.Create;
  447.    ms.LoadFromFile(FileToLoad);
  448.       for p := 8 to ms.Size do
  449.         begin
  450.            ms.Position:= p;
  451.            ms.Read(BildRec, Sizeof(BildRec));
  452.            BildFil[p-8] := BildRec.bite;
  453.         end;
  454.       ms.Free;
  455.  
  456.    for y := 0 to Bitmap.Height -1 do
  457.     begin
  458.      for x := 0 to Bitmap.Width -1 do
  459.       begin
  460.  
  461.        Bitmap.canvas.Pixels[x,y] := PalColor[Bildfil[tmpint]];
  462.        inc(tmpint); //DO NOT FORGET TO RESET THIS VARIABLE!
  463.       end;
  464.         Application.ProcessMessages;
  465.     end;
  466.     //To the "image-Trick" ('cause canvas sux as.) +(do a clean-up also)
  467.    bitmap.SaveToFile('out.bmp');
  468.    bitmap.free;
  469.    Image12.Picture.Bitmap.LoadFromFile('out.bmp');
  470.    StatusBar1.SimpleText := 'File: ' + ExtractFileName(FileToLoad) + ' | ' + IntToStr(image12.picture.Graphic.Width) + 'x' + IntToStr(image12.picture.Graphic.height);
  471.    DeleteFile('out.bmp');
  472. end;
  473.  
  474.  
  475. //This proc is one time only!
  476. procedure TForm1.LoadPal;
  477. var
  478.  PalIntTMP : integer;
  479. begin
  480.      for PalIntTMP := 0 to 255 do
  481.         begin
  482.          FixaRGB(PalIntTMP);
  483.          PalColor[PalIntTMP] := RGB(Red,Green,Blue);
  484.         end;
  485. end;
  486.  
  487.  
  488. procedure TForm1.FixaRGB(palindex:integer);
  489. type
  490.  TPal = packed record
  491.   R,G,B : byte;
  492. end;
  493. var
  494.  PalRec: TPal;
  495.  ms: TMemoryStream;
  496. begin
  497.  ms:= TMemoryStream.Create;
  498.  ms.LoadFromFile('palette.lmp');
  499.  ms.Position:= ((palindex*3)); // this was the position it started at
  500.  ms.Read(PalRec, Sizeof(PalRec));
  501.  ms.Free;
  502.  
  503.  Red := PalRec.R;
  504.  Green := PalRec.G;
  505.  Blue := PalRec.B;
  506. end;
  507.  
  508.  
  509. procedure TForm1.FormCreate(Sender: TObject);
  510. begin
  511. try
  512.  MkDir('Exported');
  513. except
  514. end;
  515.  
  516.   Export1.Enabled := False;
  517.   Import1.Enabled := False;
  518.   Save1.enabled := False;
  519.  
  520. if FileExists('palette.lmp') then
  521.     begin
  522.      PaletteFound := True;
  523.      LoadPal;
  524.     end
  525. else
  526.     begin
  527.      LoadInternalPal;
  528.      PaletteFound := True;
  529.      MessageBox(form1.Handle,'Could not find palette.lmp!' + CHR(13) +
  530.                              'Using default.','Palette Error',MB_OK + MB_ICONERROR);
  531.  
  532.     end;
  533. end;
  534.  
  535. procedure TForm1.Open1Click(Sender: TObject);
  536. begin
  537. if LoadDialog.Execute = True then
  538.  begin
  539.   try
  540.    FileToLoad := LoadDialog.FileName;
  541.    LoadLMP;
  542.    Export1.Enabled := True;
  543.    Import1.Enabled := True;
  544.    Save1.enabled := True;
  545.   except
  546.    MessageBox(form1.Handle,'Invalid LMP-Format!','Error',MB_ICONSTOP);
  547.    StatusBar1.SimpleText := '';
  548.   end;
  549.  end;
  550. end;
  551.  
  552. procedure TForm1.Exit1Click(Sender: TObject);
  553. begin
  554. form1.close;
  555. end;
  556.  
  557. procedure TForm1.Export1Click(Sender: TObject);
  558. var
  559.  tmpstr1:string;
  560. begin
  561.  if exportdialog.Execute = true then
  562.   begin
  563.    image12.Picture.Bitmap.SaveToFile(ExportDialog.FileName);
  564.   end;
  565. end;
  566.  
  567. procedure TForm1.FormPaint(Sender: TObject);
  568. begin
  569. if PaletteFound = False then
  570.  form1.close;
  571. end;
  572.  
  573. procedure TForm1.Import1Click(Sender: TObject);
  574. begin
  575. ImportBitmap;
  576. end;
  577.  
  578. procedure TForm1.Save1Click(Sender: TObject);
  579. begin
  580. try
  581.  SaveLmpImage;
  582. except
  583.    StatusBar1.SimpleText := '';
  584.    MessageBox(form1.Handle,'Could not save file!' + CHR(13) + 'Got enough space on HD?','Error',MB_ICONSTOP);   
  585. end;
  586. end;
  587.  
  588. procedure TForm1.ExtractPalette1Click(Sender: TObject);
  589. var
  590. TmpBmp:TBitmap;
  591. TmpInt1, TmpInt100,TmpInt2:integer;
  592. begin
  593. TmpInt2 := 0;
  594. TmpBmp := TBitmap.Create;
  595. TmpBmp.Width := 255;
  596. TmpBmp.Height := 10;
  597.  
  598.  with TmpBmp.Canvas do
  599.   begin
  600.    for TmpInt1 := 0 to 10 do
  601.     begin
  602.      for TmpInt100 := 0 to 255 do
  603.       begin
  604.        Pixels[TmpInt100,TmpInt1] := PalColor[TmpInt2];
  605.        Inc(TmpInt2);
  606.       end;
  607.       TmpInt2 := 0;
  608.     end;
  609.   end;
  610.  
  611. TmpBmp.SaveToFile('Palette.BMP');
  612. TmpBmp.Free;
  613. MessageBox(form1.Handle,'Palette exported to:'+CHR(13) + 'Palette.BMP','Information',MB_ICONINFORMATION);
  614.  
  615. end;
  616.  
  617. procedure TForm1.About1Click(Sender: TObject);
  618. begin
  619. MessageBox(Form1.Handle,'         About SLmpEdit 1.0' + CHR(13)+CHR(13) +
  620.                         ' Saidas Lmp Edit 1.0 features: '+CHR(13)+chr(13)+
  621.                         ' - Export LMP (for Editing).'+CHR(13)+
  622.                         ' - Import LMP (After editing).'+CHR(13) +
  623.                         ' - Save/Load LMP Files.'+CHR(13)+
  624.                         ' - Export QuakeLMPPalette.'+CHR(13)+CHR(13)+
  625.                         ' *** THIS PROGRAM CAN ONLY HANDLE QUAKE LMP! ***'+CHR(13)+CHR(13)+CHR(13)+
  626.                         ' saida@lava.nu '+CHR(13)+ ' http://saida.lava.nu','About',MB_OK);
  627. end;
  628.  
  629. procedure TForm1.Backgroundcolor1Click(Sender: TObject);
  630. begin
  631. if backgroundcolordialog.Execute = true then
  632.  form1.Color := backgroundcolordialog.Color;
  633. end;
  634.  
  635. end.
  636.